Load packages

# CRAN packages
library(dplyr)
library(ggplot2)

# devtools::install_github("mbcann01/dataclean")
library(dataclean)

Load data

load("data/daily_april_2016.RData")

# Sort by case number and date
daily <- dplyr::arrange(daily, case_number, date)
about_data(daily)
#> 1390 observations and 129 variables in the data

 

The goal of this analysis is to plot participant responses on a circumplex model of affect.

“The circumplex model of emotion was developed by James Russell. This model suggests that emotions are distributed in a two-dimensional circular space, containing arousal and valence dimensions. Arousal represents the vertical axis and valence represents the horizontal axis, while the center of the circle represents a neutral valence and a medium level of arousal.”

(Wikipedia, 2016)

Source: BIOPAC Systems, Inc.

 


 

Column plots of aggregate emotional responses

x <- names(select(daily, 4:13))
for (var in x) {
  plot <- ggplot2::ggplot(daily, ggplot2::aes_string(x = var)) +
    ggplot2::geom_bar() +
    ggplot2::scale_x_discrete("") +
    ggplot2::ggtitle(paste("I Feel", tools::toTitleCase(var), "Right Now")) +
    ggplot2::theme_bw()
  print(plot)
}

Methods

  1. Give each emotion an x and y value that relates to its quadrant on the CMOA chart, and the strength with which the participant felt that emotion. For example:

    • Happy is in quadrant 1, so its X value is positive and its Y value is positive when experienced. If the participant Strongly agrees, then the values are positive 2. If the particpant is Neutral, then the values are 0. If the participant Strongly disagrees, then the values are negative 2.

    • Frustrated is in quadrant 2, so its X value is negative and its Y value is positive when experienced. If the participant Strongly agrees, then X is negative 2 and Y is positive 2.

  2. Plot the relationship between emotion and behaviors and emotion and substance use:

    • What they were doing right before they took the assessment: other_act, sit_act, sleep_act, stand_act, walk_act, talk_act

    • What they did yesterday: bike_yest, run_yest, cleaning_yest, non_yest, min_walk_c, min_run_c, min_act_c, min_sit_c,

    • Substance use yesterday: alc_sub, cig_sub, mar_sub, opi_sub, stim_sub, herb_sub, other_sub, none_sub

# For emotions in quadrant 1
quad1 <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- -2
  new[x == "Disagree"] <- -1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- 1
  new[x == "Strongly agree"] <- 2
  return(new)
}

# For emotions in quadrant 2
quad2x <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- 2
  new[x == "Disagree"] <- 1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- -1
  new[x == "Strongly agree"] <- -2
  return(new)
}

quad2y <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- -2
  new[x == "Disagree"] <- -1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- 1
  new[x == "Strongly agree"] <- 2
  return(new)
}

# For emotions in quadrant 3
quad3 <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- 2
  new[x == "Disagree"] <- 1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- -1
  new[x == "Strongly agree"] <- -2
  return(new)
}

# For emotions in quadrant 4
quad4x <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- -2
  new[x == "Disagree"] <- -1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- 1
  new[x == "Strongly agree"] <- 2
  return(new)
}

quad4y <- function(x) {
  new <- NA
  new[x == "Strongly disagree"] <- 2
  new[x == "Disagree"] <- 1
  new[x == "Neutral"] <- 0
  new[x == "Agree"] <- -1
  new[x == "Strongly agree"] <- -2
  return(new)
}

# Create x and y coordinates for each row
daily <- daily %>%
  mutate(
    x_happy      = ifelse(date_match == 1, quad1(happy_lag), NA),
    y_happy      = ifelse(date_match == 1, quad1(happy_lag), NA),
    x_frustrated = ifelse(date_match == 1, quad2x(frustrated_lag), NA),
    y_frustrated = ifelse(date_match == 1, quad2y(frustrated_lag), NA),
    x_sad        = ifelse(date_match == 1, quad3(sad_lag), NA),
    y_sad        = ifelse(date_match == 1, quad3(sad_lag), NA),
    x_worried    = ifelse(date_match == 1, quad2x(worried_lag), NA),
    y_worried    = ifelse(date_match == 1, quad2y(worried_lag), NA),
    x_restless   = ifelse(date_match == 1, quad2x(restless_lag), NA),
    y_restless   = ifelse(date_match == 1, quad2y(restless_lag), NA),
    x_excited    = ifelse(date_match == 1, quad1(excited_lag), NA),
    y_excited    = ifelse(date_match == 1, quad1(excited_lag), NA),
    x_calm       = ifelse(date_match == 1, quad4x(calm_lag), NA),
    y_calm       = ifelse(date_match == 1, quad4y(calm_lag), NA),
    x_lonely     = ifelse(date_match == 1, quad3(lonely_lag), NA),
    y_lonely     = ifelse(date_match == 1, quad3(lonely_lag), NA),
    x_bored      = ifelse(date_match == 1, quad3(bored_lag), NA),
    y_bored      = ifelse(date_match == 1, quad3(bored_lag), NA),
    x_sluggish   = ifelse(date_match == 1, quad3(sluggish_lag), NA),
    y_sluggish   = ifelse(date_match == 1, quad3(sluggish_lag), NA)
  )

# Aggregate across all X values
daily <- daily %>%
  mutate(
    x = x_happy + x_frustrated + x_sad + x_worried + x_restless + x_excited + x_calm + x_lonely + x_bored + x_sluggish,
    y = y_happy + y_frustrated + y_sad + y_worried + y_restless + y_excited + y_calm + y_lonely + y_bored + y_sluggish
  )

# Data check:
# View(daily[c("case_number", "date", "date_yest", "date_lag", "date_match", "happy", "alc_sub", "happy_lag", "x_happy", "y_happy", "x")])

Plot the relationship between emotion and substance use as a CMOA plot

# Aggregate emotions and any substance use
subs <- select(daily, 90:97)                  # Grab emotion variables
sub_name <- names(select(daily, 90:97))       # Just names for legend title
i <- 1
for (sub in subs) {
  p <- ggplot(daily, aes(x = x, y = y, col = sub)) +
    geom_jitter(alpha = 0.6) +
    geom_hline(yintercept = 0) + geom_vline(xintercept = 0) +
    scale_y_continuous("Arousal") +
    scale_x_continuous("Valence") +
    scale_color_manual(sub_name[i], values = c("#377EB8", "#E41A1C")) +
    ggtitle(paste("Emotions Overall and", sub_name[i])) +
    theme_bw()
  print(p)
  i <- i + 1
}
#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).


# For each emotion
subs <- select(daily, 90:97)                  # Grab emotion variables
sub_name <- names(select(daily, 90:97))       # Just names for legend title
x_var <- select(daily, seq(130, 148, by = 2)) # all the x_ variables
y_var <- select(daily, seq(131, 149, by = 2)) # all the y_ variables
title <- c("Happy", "Frustrated", "Sad", "Worried", "Restless", "Excited", "Calm", "Lonely", "Bored", "Sluggish")
i <- 1
for (sub in subs) {                           # Substances
  for (j in 1:length(x_var)){                 # Emotions
    p <- ggplot(daily, aes(x = x_var[j], y = y_var[j], col = sub)) +
      geom_jitter(alpha = 0.6) +
      geom_hline(yintercept = 0) + geom_vline(xintercept = 0) +
      scale_y_continuous("Arousal") +
      scale_x_continuous("Valence") +
      scale_color_manual(sub_name[i], values = c("#377EB8", "#E41A1C")) +
      ggtitle(paste(title[j], "and", sub_name[i])) +
      theme_bw()
    print(p)
  }
  i <- i + 1
}
#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

#> Warning: Removed 469 rows containing missing values (geom_point).

Issues

  1. It could be somewhat flawed by the fact that it treats all areas WITHIN each quadrant as equivalent.

  2. We also don’t have an equivalent number of emotions from each quadrant.

  3. May be more informative to limit to “users”. Some people will not use at all; however, among those that do use, XYZ is a predictor.

 


 

Clean up

rm(x, var, plot)

Session Info:

#> R version 3.3.0 (2016-05-03)
#> Platform: x86_64-apple-darwin13.4.0 (64-bit)
#> Running under: OS X 10.11.5 (El Capitan)
#> 
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] dataclean_0.1.0 ggplot2_2.1.0   dplyr_0.4.3    
#> 
#> loaded via a namespace (and not attached):
#>  [1] Rcpp_0.12.4      digest_0.6.9     assertthat_0.1   plyr_1.8.3      
#>  [5] grid_3.3.0       R6_2.1.2         gtable_0.2.0     DBI_0.4-1       
#>  [9] formatR_1.3      magrittr_1.5     scales_0.4.0     evaluate_0.9    
#> [13] stringi_1.0-1    lazyeval_0.1.10  rmarkdown_0.9.6  labeling_0.3    
#> [17] tools_3.3.0      stringr_1.0.0    munsell_0.4.3    yaml_2.1.13     
#> [21] parallel_3.3.0   colorspace_1.2-6 htmltools_0.3.5  knitr_1.12.3